home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog5.arj / JAGGIES.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  2.8 KB  |  117 lines
  1. { jaggies.pas -- Draw jagged lines }
  2.  
  3. program Jaggies;
  4.  
  5. uses WinTypes, WinProcs, WObjects;
  6.  
  7. type
  8.  
  9.   GrApplication = object(TApplication)
  10.     procedure InitMainWindow; virtual;
  11.   end;
  12.  
  13.   PGraphWindow = ^GraphWindow;
  14.   GraphWindow = object(TWindow)
  15.     ButtonDown : Boolean;
  16.     Dc : HDC;
  17.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  18.     function GetClassName: PChar;
  19.       virtual;
  20.     procedure GetWindowClass(var AWndClass: TWndClass);
  21.       virtual;
  22.     procedure WMLButtonDown(var Msg: TMessage);
  23.       virtual wm_First + wm_LButtonDown;
  24.     procedure WMLButtonUp(var Msg: TMessage);
  25.       virtual wm_First + wm_LButtonUp;
  26.     procedure WMMouseMove(var Msg: TMessage);
  27.       virtual wm_First + wm_MouseMove;
  28.     procedure WMLButtonDblClk(var Msg: TMessage);
  29.       virtual wm_First + wm_LButtonDblClk;
  30.   end;
  31.  
  32. { GrApplication }
  33.  
  34. {- Initialize the application's window }
  35. procedure GrApplication.InitMainWindow;
  36. begin
  37.   MainWindow := New(PGraphWindow,
  38.     Init(nil, 'Jaggies -- Double click to clear'))
  39. end;
  40.  
  41. { GraphWindow }
  42.  
  43. {- Initialize a GraphWindow object }
  44. constructor GraphWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  45. begin
  46.   TWindow.Init(AParent, ATitle);
  47.   ButtonDown := false
  48. end;
  49.  
  50. {- Return class name for modified window class }
  51. function GraphWindow.GetClassName: PChar;
  52. begin
  53.   GetClassName := 'GraphWindow'
  54. end;
  55.  
  56. {- Modify window style to recognize double clicks }
  57. procedure GraphWindow.GetWindowClass(var AWndClass: TWndClass);
  58. begin
  59.   TWindow.GetWindowClass(AWndClass);
  60.   AWndClass.Style := AWndClass.Style or cs_DblClks
  61. end;
  62.  
  63. {- Respond to left-button-down mouse clicks }
  64. procedure GraphWindow.WMLButtonDown(var Msg: TMessage);
  65. begin
  66.   if not ButtonDown then
  67.   begin
  68.     ButtonDown := true;
  69.     SetCapture(HWindow);
  70.     Dc := GetDC(HWindow);
  71.     MoveTo(Dc, Msg.LParamLo, Msg.LParamHi)
  72.   end
  73. end;
  74.  
  75. {- Respond to left-button-up mouse clicks }
  76. procedure GraphWindow.WMLButtonUp(var Msg: TMessage);
  77. begin
  78.   if ButtonDown then
  79.   begin
  80.     ReleaseCapture;
  81.     ReleaseDC(HWindow, Dc);
  82.     ButtonDown := False
  83.   end
  84. end;
  85.  
  86. {- Respond to mouse movements }
  87. procedure GraphWindow.WMMouseMove(var Msg: TMessage);
  88. begin
  89.   if ButtonDown then with Msg do
  90.   begin
  91.     LineTo(Dc, LParamLo, LParamHi);
  92.     LineTo(Dc, LParamLo - 4, LParamHi + 4)
  93.   end
  94. end;
  95.  
  96. {- Respond to left-button double clicks }
  97. procedure GraphWindow.WMLButtonDblClk(var Msg: TMessage);
  98. begin
  99.   InvalidateRect(HWindow, nil, true)
  100. end;
  101.  
  102. var
  103.  
  104.   GrApp: GrApplication;
  105.  
  106. begin
  107.   GrApp.Init('GrApp');
  108.   GrApp.Run;
  109.   GrApp.Done
  110. end.
  111.  
  112.  
  113. {--------------------------------------------------------------
  114.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  115.   Revision 1.00    Date: 1/30/1991
  116. ---------------------------------------------------------------}
  117.